Automation MS Visual Basic sample

Microsoft Visual Basic 6.0 sample

Project and testVB.exe see in directory TestVB. This runs program FindGraph in new window.

Private Declare Function GetModuleFileName Lib "kernel32" _
         Alias "GetModuleFileNameA" _
         (ByVal hModule As Long, _
         ByVal lpFileName As String, _
         ByVal nSize As Long) As Long

Dim FindGraph As Object

Sub LogError()
    Print "error " & Err.Description
End Sub

Private Sub Form_Load()
    On Error GoTo ErrHandler
    ' Create object FindGraph
    Set FindGraph = CreateObject("FindGraph.Document")
    ' Run program FindGraph in new window
    FindGraph.AppInit (1)

    Exit Sub
ErrHandler:
    LogError
    Exit Sub
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error GoTo ErrHandler
    ' Close FindGraph application
    FindGraph.AppQuit
ErrHandler:
    Set FindGraph = Nothing
End Sub

' The example how to hide/show FindGraph main window
Private Sub CheckVisible_Click()
    FindGraph.Visible = CheckVisible.Value 'True
End Sub

' The example how to add series of points
' Create new series named "VB_series"
' Add 500 points at once
Private Sub TestAddArray_Click()
    On Error GoTo ErrHandler
    Dim dwId, it, N As Long
    Dim fX, fY, fZ As Double

    N = 500
    Dim va(1500) As Variant ' dimension N*3

    ' Create new series of points
    dwId = FindGraph.DotsNew(2, 2, 20, 1, "VB_series")
    ' Set the identifier of a series
    FindGraph.ArrayId = dwId
    ' Fill array with points
    For i = 1 To N
        fX = CDbl(8# / N * i)
        fY = CDbl(5# / N * i)
        fZ = CDbl(i)
        it = (i - 1) * 3
        va(it) = fX
        va(it + 1) = fY
        va(it + 2) = fZ
    Next i
    ' Add all array at once
    FindGraph.ArrayVar = va
    ' Repaint points
    FindGraph.DotsUpdate dwId
    Exit Sub
ErrHandler:
    LogError
    Exit Sub
End Sub

' The example how to add one point to series
' Create new series named "VB_point"
' Add 20 points on one
Private Sub TestAddOne_Click()
    On Error GoTo ErrHandler
    Dim dwId, it, N As Long
    Dim fX, fY, fZ As Double

    N = 20
    ' Create new series of points
    dwId = FindGraph.DotsNew(1, 1, 50, 1, "VB_point")
    For i = 1 To N
        fX = CDbl(0.3 * i)
        fY = CDbl(0.4 * i)
        ' Add single point to series
        FindGraph.DotsAddPoint dwId, fX, fY, 0
        ' Repaint points
        FindGraph.DotsUpdate dwId
    Next i
    FindGraph.DotsUpdate dwId
    Exit Sub
ErrHandler:
    LogError
    Exit Sub
End Sub

' Create and select new area named "clip"
' Use nodes from VARIANT var array
Private Sub NewClip()
    Dim dwId As Long
    On Error GoTo ErrHandler
    dwId = FindGraph.ClipNewEmptyRgn(1) ' BLUE
    FindGraph.ArrayId = dwId
    ' Nodes (X,Y)
    Dim va(12) As Variant ' dimension 4*3
        va(0) = 1# '(1,5)
        va(1) = 5#
        va(2) = 0#
        va(3) = 5# '(5,8)
        va(4) = 8#
        va(5) = 1#
        va(6) = 7# '(7,5)
        va(7) = 5#
        va(8) = 2#
        va(9) = 5# '(5,1)
        va(10) = 1#
        va(11) = 3#
    ' Create array of nodes
    FindGraph.ArrayVar = va
    ' Select the area
    FindGraph.ClipSelect dwId, 1

    Exit Sub
ErrHandler:
    LogError
    Exit Sub
End Sub

' The example how to create new area and get all points selected
Private Sub TestGet_Click()
    On Error GoTo ErrHandler
    Dim fX, fY, fZ As Double
    ListInit
    ' Create new area and select it
    NewClip

    ' The example how to get whole array of points immediately
    ' Points - three-tuples (X,Y,Z)
    ' Copy selected points, put it on the buffer.
    ' N number of points selected
    N = FindGraph.SelectedGetStart(0)
    Dim va As Variant
    va = FindGraph.ArrayVar
    NGet = (UBound(va) + 1) / 3
    If N > NGet Then N = NGet
    Print "ub"; UBound(va)
    ' Fill the grid with points (X, Y, Z)
    For i = 1 To N
        it = 3 * (i - 1)
        fX = va(it)
        fY = va(it + 1)
        fZ = va(it + 2)
        ListAdd fX, fY, fZ
    Next i
    ' Free memory
    FindGraph.SelectedGetStop (0)
    Exit Sub


    ' The example how to get single point
    ' Points - three-tuples (X,Y,Z)
    ' Copy selected points, put it on the buffer.
    ' N number of points selected
    N = FindGraph.SelectedGetStart(0)
    Print "n"; N
    ' In cycle we choose points and add to grid
    For i = 1 To N
        fX = FindGraph.SelectedGetX(i - 1)
        fY = FindGraph.SelectedGetY(i - 1)
        fZ = FindGraph.SelectedGetZ(i - 1)
        ListAdd fX, fY, fZ
    Next i
    ' Free memory
    FindGraph.SelectedGetStop (0)
    Exit Sub


ErrHandler:
    LogError
    Exit Sub
End Sub
' The example how to change plot properties
Private Sub TestProp_Click()
    On Error GoTo ErrHandler
    ' Change the title
    FindGraph.DocTitle = "From VB title"
    ' Change the scale of X axe
    FindGraph.AxeXscale = 2
    ' Repaint
    FindGraph.DocUpdate
    Exit Sub
ErrHandler:
    LogError
    Exit Sub
End Sub

' The example how to digitize the background picture
' Display the background picture
' Create rectangle area and select it
' Digitize blue line inside rectangle
' Create new series named "FromPict"
' Assign green color and radius of circle 1 mm to points of series
Private Sub Digitize_Click()
    On Error GoTo ErrHandler

    'Get file name from module path and exe name
    Dim strFileName As String
    Dim lngCount As Long
    strFileName = String(512, 0)
    lngCount = GetModuleFileName(App.hInstance, strFileName, 512)
    strFileName = Left(strFileName, lngCount - 10) & "money.gif"

    ' Change the title
    FindGraph.DocTitle = "Digitize Now"
    ' Set background picture file name
    'FindGraph.DocPictFileName = "d:\vc\FindGraph\TestVB\money.gif"
    FindGraph.DocPictFileName = strFileName
    ' Display background picture
    FindGraph.DocPictIs = True
    ' rectangle in physical units from (1,4) to (10,8)
    ' Get axes scales
    Dim fXStart, fXScale, fYStart, fYScale As Double
    fXStart = FindGraph.AxeXstart
    fXScale = FindGraph.AxeXscale
    fYStart = FindGraph.AxeYstart
    fYScale = FindGraph.AxeYscale

    ' Calculate rectangle
    Dim fLeft, fTop, fRight, fBottom As Double
    fLeft = fXStart + fXScale * 1#
    fTop = fYStart + fYScale * 4#
    fRight = fXStart + fXScale * 10#
    fBottom = fYStart + fYScale * 8#

     ' Create rectangle area with color number = 2 (GREEN)
    Dim dwIdArea As Long
    dwIdArea = FindGraph.ClipNewRect(2, fLeft, fTop, fRight, fBottom)
     ' Select area
    FindGraph.ClipSelect dwIdArea, 1


    ' Digitize points inside rectangle
    ' Color number = 1 (BLUE)
    ' Radius of digitizing = 20 (2.0 mm)
    Dim dwIdDots As Long
    dwIdDots = FindGraph.DotsFromPict(1, 20, "FromPict")
    ' Assign green color, color number = 2 (GREEN)
    FindGraph.DotsColorNumSet dwIdDots, 2
    ' Assign radius of new points = 10 (1.0 mm)
    FindGraph.DotsWidthSet dwIdDots, 10

    ' Repaint
    FindGraph.DocUpdate
    Exit Sub
ErrHandler:
    LogError
    Exit Sub
End Sub
Private Sub ListInit()
    ListView1.ListItems.Clear
    Dim Col As ColumnHeader ' Declare variable
    Set Col = ListView1.ColumnHeaders.Add(, , "X", ListView1.Width / 3)
    Set Col = ListView1.ColumnHeaders.Add(, , "Y", ListView1.Width / 3)
    Set Col = ListView1.ColumnHeaders.Add(, , "Z", ListView1.Width / 3)
End Sub

Private Sub ListAdd(X, Y, Z)
    Dim Insert As ListItem
    Set Insert = ListView1.ListItems.Add(, , CStr(X))
    Insert.SubItems(1) = CStr(Y)
    Insert.SubItems(2) = CStr(Z)
End Sub

See documentation Automation: methods and properties.